#!/usr/bin/perl -wc

package RFCMail::ESMTP::Server::Query::DNSBL;

use strict;
use RFCMail::DNS::BlockList::Target;
use RFCMail::ESMTP::Object::ForwardPath;


sub session {
    my $self = shift;
    if ($self->{peer_end}->address) {
	my $target = RFCMail::DNS::BlockList::Target->new_ip($self->{peer_end}->address);
	$self->{state}->{DNSBL_IP} = $target;
	if ($self->{dnsbl_ip}) {
	    my @hits = $target->hits(@{$self->{dnsbl_ip}});
	    $self->logmsg(i => "Peer found in IPBLs: ".join(', ', @hits))
		if @hits;
	}
    }
    return ($self->SUPER::session(@_));
}


sub mail_from {
    my $self = shift;
    my ($from) = @_;
    if ($from->is_path) {
	my $target = RFCMail::DNS::BlockList::Target->new_rhs($from->domain);
	$self->{state}->{dnsbl_rhs} = $target;
	if ($self->{dnsbl_rhs}) {
	    my @hits = $target->hits(@{$self->{dnsbl_rhs}});
	    $self->logmsg(i => "Domain found in RHSBLs: ".join(', ', @hits))
		if @hits;
	}
    }
    return ($self->SUPER::mail_from(@_));
}


sub include_xblinfo_handler {
    my ($self) = @_;
    $self->{handlers}->set('XBLINFO', undef, 'xblinfo_handler', 'xblinfo_ehlo');
    return ($self);
}


sub xblinfo_handler {
    my ($self, $cmd) = @_;
    my $state = $self->{state};
    my @result = (211);
    if ($state->{DNSBL_IP}) {
	push @result, "IP-based blocklist summary:", map("  $_", $state->{DNSBL_IP}->summary);
    }
    else {
	push @result, "IP-based blocking not possible in this session.";
    }
    if ($state->{dnsbl_rhs}) {
	push @result, "RHS-based blocklist summary:", map("  $_", $state->{dnsbl_rhs}->summary);
    }
    else {
	push @result, "RHS-based blocking not possible at this point.";
    }
    return (\@result);
}


sub xblinfo_ehlo {
    my ($self) = @_;
    my @ip_hits;
    @ip_hits = $self->{state}->{DNSBL_IP}->hits
	if $self->{state}->{DNSBL_IP};
    return (join(" ", "XBLINFO", @ip_hits));
}


1;
